Monster Media 1994 #2/Monster Media No. 2 (Monster Media)(1994).ISO/prog_bas/mquery.zip/MPROFILE.FRM

Text File | 1994-05-24 | 11KB | 445 lines

VERSION 2.00
Begin Form fStoreQry
   BackColor       =   &H00C0C0C0&
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Stored Query Manager"
   ClientHeight    =   3960
   ClientLeft      =   1290
   ClientTop       =   2685
   ClientWidth     =   4980
   ClipControls    =   0   'False
   ControlBox      =   0   'False
   Height          =   4365
   Left            =   1230
   LinkMode        =   1  'Source
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   3960
   ScaleWidth      =   4980
   Top             =   2340
   Width           =   5100
   Begin OptionButton OpSQLUser
      BackColor       =   &H00C0C0C0&
      Caption         =   "Public:"
      Height          =   240
      Index           =   1
      Left            =   465
      TabIndex        =   7
      Top             =   2250
      Width           =   885
   End
   Begin OptionButton OpSQLUser
      BackColor       =   &H00C0C0C0&
      Caption         =   "Private:"
      Height          =   240
      Index           =   0
      Left            =   465
      TabIndex        =   13
      Top             =   1950
      Value           =   -1  'True
      Width           =   915
   End
   Begin CommandButton DeleteBtn
      Cancel          =   -1  'True
      Caption         =   "&Delete"
      Height          =   375
      Left            =   3735
      TabIndex        =   12
      Top             =   3060
      Width           =   1035
   End
   Begin SSPanel msgpanel
      Align           =   2  'Align Bottom
      BevelInner      =   1  'Inset
      Height          =   420
      Left            =   0
      TabIndex        =   6
      Top             =   3540
      Width           =   4980
   End
   Begin ListBox cqueries
      BackColor       =   &H00C0C0C0&
      ForeColor       =   &H00000000&
      Height          =   1005
      Left            =   570
      Sorted          =   -1  'True
      TabIndex        =   11
      TabStop         =   0   'False
      Top             =   390
      Width           =   3855
   End
   Begin CommandButton BtnQuit
      Caption         =   "&Quit"
      Height          =   375
      Left            =   2520
      TabIndex        =   5
      Top             =   3060
      Width           =   1035
   End
   Begin CommandButton BtnRead
      Caption         =   "&Load"
      Height          =   375
      Left            =   1305
      TabIndex        =   4
      Top             =   3060
      Width           =   1035
   End
   Begin CommandButton BtnWrite
      Caption         =   "&Save"
      Height          =   375
      Left            =   120
      TabIndex        =   3
      Top             =   3060
      Width           =   1035
   End
   Begin TextBox TxtKey
      BackColor       =   &H00C0C0C0&
      Height          =   375
      Left            =   1500
      TabIndex        =   2
      Top             =   2520
      Width           =   2895
   End
   Begin TextBox TxtSection
      BackColor       =   &H00C0C0C0&
      Height          =   375
      Left            =   1500
      TabIndex        =   1
      TabStop         =   0   'False
      Top             =   2040
      Width           =   2895
   End
   Begin TextBox TxtINIFile
      BackColor       =   &H00C0C0C0&
      Enabled         =   0   'False
      Height          =   375
      Left            =   1500
      TabIndex        =   0
      TabStop         =   0   'False
      Top             =   1560
      Width           =   2895
   End
   Begin Label lblQueries
      Alignment       =   2  'Center
      AutoSize        =   -1  'True
      BackColor       =   &H00C0C0C0&
      Caption         =   "Select Query"
      Height          =   195
      Left            =   540
      TabIndex        =   9
      Top             =   210
      Width           =   1125
   End
   Begin Label LblKey
      Alignment       =   1  'Right Justify
      AutoSize        =   -1  'True
      BackColor       =   &H00C0C0C0&
      Caption         =   "Query Name:"
      Height          =   195
      Left            =   285
      TabIndex        =   8
      Top             =   2640
      Width           =   1110
   End
   Begin Label LblINIFile
      Alignment       =   1  'Right Justify
      AutoSize        =   -1  'True
      BackColor       =   &H00C0C0C0&
      Caption         =   "Storage:"
      Height          =   195
      Left            =   690
      TabIndex        =   10
      Top             =   1620
      Width           =   735
   End
End
Dim FwriteFlag As Integer ' did I   write
Dim Fdelstr As String
Dim FSection As String
Dim fDefaultuser As String

Sub BtnQuit_Click ()
' written or quit
If FwriteFlag Then ' stored query
FwriteFlag = False
End If
gstDynaString = ""

' was this a stored query that was run
If Not gStoredFlag Then     'not from storage
    fQuery!RunSaveQryButton.Enabled = True
    fQuery!RunQueryButton.Enabled = False
        If gfFROMSQL Then  ' was a SQL Statement?
            fQuery!RunQueryButton.Enabled = False
        End If
Else
    fQuery!RunSaveQryButton.Enabled = True
End If
Unload Me
End Sub

Sub BtnRead_Click ()
    If TxtINIFile.Text = "" Then
        Beep
        TxtINIFile.SetFocus
        Exit Sub
    End If

    If TxtSection.Text = "" Then
        Beep
        TxtSection.SetFocus
        Exit Sub
    End If

    If Txtkey.Text = "" Then
        Beep
        Txtkey.SetFocus
        Exit Sub
    End If


    'Assign textbox contents to variables for API call.
    '(API call won't take references to Textbox contents.)
    Sectn$ = TxtSection.Text
    Keyy$ = Txtkey.Text
    DeeFalt$ = ""
    FileNam$ = gWindowsDirectory + "\" + TxtINIFile.Text

     gstDynaString = StringfromPrivINI(Sectn$, Keyy$, DeeFalt$, FileNam$)

    If gstDynaString = "" Then
        msgpanel.Caption = "Section, Key or File name not found."
    Else


          fQuery!RunSaveQryButton.Enabled = False
          DeleteBtn.Enabled = True
         Unload Me
    End If

End Sub

Sub BtnWrite_Click ()
     FwriteFlag = False
     DeleteBtn.Enabled = False
    If TxtSection.Text = "" Then
        Beep
        TxtSection.SetFocus
        Exit Sub
    End If

    If Txtkey.Text = "" Then
        Beep
        Txtkey.SetFocus
        Exit Sub
    End If

    ' clear out GstDynaString if it has carriage return and linefeeds
    ' pasted or otherwise inserted
    a% = 0
    For y% = 1 To Len(gstDynaString) - 2
    a% = InStr(y% + a%, gstDynaString, Chr(13) + Chr(10))
            If a% Then
                gstDynaString = Left(gstDynaString, a% - 1) + " " + Mid(gstDynaString, a% + 2, Len(gstDynaString))
            End If
    Next y%


    Sectn$ = TxtSection.Text
    Keyy$ = Txtkey.Text
    Valyue$ = gstDynaString
    FileNam$ = gWindowsDirectory + "\" + TxtINIFile.Text

    Result% = StringtoPrivINI(Sectn$, Keyy$, Valyue$, FileNam$)
    If Result% = 0 Then
         msgpanel.Caption = "QUERY NOT SAVED."
    Else
         msgpanel.Caption = "QUERY SAVED."
         FwriteFlag = True
    End If
    gstDynaString = ""
End Sub

Sub cqueries_Click ()
If gstDynaString = "" Then
Txtkey.Text = cqueries.List(cqueries.ListIndex)
BtnRead.Enabled = True
DeleteBtn.Enabled = True
msgpanel.Caption = "QUERY SELECTED ...LOAD OR DELETE OR QUIT."
End If
End Sub

Sub cqueries_KeyPress (keyascii As Integer)
keyascii = 0
End Sub

Sub DeleteBtn_Click ()
Fdelstr = Txtkey.Text
If MsgBox("Delete " & Fdelstr & " ?", MSGBOX_TYPE) = YES Then
delquery
Unload Me
End If
End Sub

Sub delquery ()
Dim f As String
Dim h As String
Dim a As Integer
Dim b As Integer
Dim filein As String
Dim fileout As String
On Error GoTo errorhere


a = InStr(1, TxtINIFile.Text, ".")

filein = gWindowsDirectory + "\" + TxtINIFile.Text
fileout = gWindowsDirectory + "\" + Left(TxtINIFile, a) + "bak"
h = FSection
Open filein For Input As 1
Open fileout For Output As 2
h = Fdelstr
a = 0
Do Until a > 0
    Line Input #1, f
    a = InStr(1, f, FSection)
    Print #2, f
Loop

Do Until EOF(1)
     Line Input #1, f
     a = InStr(1, f, h)
     b = InStr(1, f, "[")
     If b = 1 Then ' found new section
        Print #2, f
        h = "XXXXXX"
     Else
         If a = 0 Then
         Print #2, f
         End If
     End If
Loop

closeem:
        Close 1
        Close 2
Kill filein
Name fileout As filein
MsgBox Fdelstr & " Deleted", 48
Exit Sub
errorhere:
MsgBox "Error " & Str(Err), 48
Resume closeem
End Sub

Sub Form_Load ()
    fStoreQry.Left = (Screen.Width - fStoreQry.Width) / 2
    fStoreQry.Top = (Screen.Height - fStoreQry.Height) / 2

'*******************************************************
'*  FDefaultuser can be the user ID from a network     *
'*  Then sections can be PUBLIC for all users and      *
'*  Private for the individual.  This way someone      *
'*  who has a particular query for the database        *
'*  can share it with others.                          *
'*******************************************************

       gWindowsDirectory = WinDir()
       fDefaultuser = "SMYTHERE" ' from network ID if MU
       gSQLUser = fDefaultuser
       getsections

        BtnWrite.Enabled = False
        BtnRead.Enabled = False
        DeleteBtn.Enabled = False

If gstDynaString <> "" Then
Txtkey.Text = ""
BtnWrite.Enabled = True
DeleteBtn.Enabled = False
msgpanel.Caption = "Enter a Query Name then SAVE or QUIT"
End If

End Sub

Sub getsections ()
Dim a As Integer
Dim b As Integer
Dim f As String
Dim filein As String
FSection = gSQLUser

TxtSection.Text = FSection
TxtINIFile.Text = "STOREQRY.INI"

filein = TxtINIFile.Text

On Error GoTo nofile
Open gWindowsDirectory + "\" + TxtINIFile.Text For Input As 1

Do
    Line Input #1, f
    a = InStr(1, f, "[" + FSection + "]")
Loop Until a > 0
' check to see why loop ended
If a Then ' found the section
    Do ' loop until no more keys
            If EOF(1) Then
                Close 1
                Exit Sub
            End If

        Line Input #1, f  ' read next line
        a = InStr(1, f, "=") ' if true then we have a key and value
            If a = 0 Then
                    Close 1
                    Exit Sub
            End If

                b = InStr(1, f, "=")  ' true so parse it
                cqueries.AddItem Left(f, b - 1) 'add query name to combo box
    Loop

Else ' this database not here
MsgBox gstDBname + " Not Found"
Close 1
Exit Sub
End If

getout:
Close 1
Exit Sub
nofile:
If Err = 62 Then
Resume getout
Else
MsgBox "error = " + Str(Err)
Resume getout
End If



End Sub

Sub opSQLUser_Click (Index As Integer)
SQLUserSelect (Index)
cqueries.Clear
getsections' Form_Load
End Sub

Sub SQLUserSelect (I As Integer)
If I = 0 Then
  gSQLUser = fDefaultuser
Else
  gSQLUser = "PUBLIC"
End If
End Sub

Sub TxtKey_KeyPress (keyascii As Integer)
If gstDynaString = "" Then
keyascii = 0
End If
End Sub